home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Advanced S22185742001.psc / frmTest.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2001-06-28  |  4.2 KB  |  130 lines
  1. VERSION 5.00
  2. Begin VB.Form frmTest 
  3.    AutoRedraw      =   -1  'True
  4.    Caption         =   "Form1"
  5.    ClientHeight    =   3735
  6.    ClientLeft      =   60
  7.    ClientTop       =   345
  8.    ClientWidth     =   3975
  9.    DrawWidth       =   2
  10.    LinkTopic       =   "Form1"
  11.    MDIChild        =   -1  'True
  12.    ScaleHeight     =   249
  13.    ScaleMode       =   3  'Pixel
  14.    ScaleWidth      =   265
  15. Attribute VB_Name = "frmTest"
  16. Attribute VB_GlobalNameSpace = False
  17. Attribute VB_Creatable = False
  18. Attribute VB_PredeclaredId = True
  19. Attribute VB_Exposed = False
  20. ' frmTest
  21. ' This is the main form, where the shape is exhibited. Multiple
  22. ' instances of this form can be loaded to view more than one shape.
  23. Option Explicit
  24. ' Declare new csShape variable
  25. Public WithEvents Gadget As csShape
  26. Attribute Gadget.VB_VarHelpID = -1
  27. ' Properties to use with frmToolbox
  28. Public ShowGrid As Boolean
  29. Public ShowAxis As Boolean
  30. Public Gradient As Boolean
  31. Public BkColor As Long
  32. Public BaseColor As Long
  33. Public GradColor As Long
  34. Public LineWidth As Integer
  35. Dim NumLines As Long ' Stores the number of lines in a shape
  36. Private Sub Form_Activate()
  37.     ' Select this shape for viewing in the toolbox
  38.     Set SelWindow = Me
  39.     frmToolbox.GetSettings
  40.     frmToolbox.Activate True
  41. End Sub
  42. Private Sub DrawShape()
  43.     BackColor = BkColor
  44.     Cls ' Clear work area
  45.     With Gadget
  46.         DrawGrid SetPnt(20 * (.Zoom / 100), 20 * (.Zoom / 100)) ' Draw grid
  47.         DrawWidth = LineWidth
  48.         
  49.         ' Retrieve the number of sequences times the number of
  50.         ' vectors. This is how many total lines would have to be drawn
  51.         ' to create an enclosed shape. The NumLines variable is used
  52.         ' in making the shape's color gradient.
  53.         NumLines = .NumSequences * .VectorCnt
  54.         
  55.         .Color = BaseColor
  56.         
  57.         ' Draw the shape to the form
  58.         .DrawShape
  59.     End With
  60. End Sub
  61. Private Sub DrawGrid(Pos As PointAPI)
  62. Dim i As Integer, CurPos As PointAPI
  63.     On Error Resume Next
  64.     If Pos.X = 0 Or Pos.Y = 0 Then Exit Sub
  65.     Do While Pos.X < 5 Or Pos.Y < 5
  66.         Pos = SetPnt(Pos.X * 10, Pos.Y * 10)
  67.     Loop
  68.     CurPos = SetPnt(Gadget.Left Mod Pos.X - Pos.X, Gadget.Top Mod Pos.Y - Pos.Y)
  69.     ' Draw grid to drawing field.
  70.     If ShowGrid Then
  71.         DrawWidth = 1
  72.         For i = 1 To ScaleHeight / Pos.Y
  73.             Line (0, CurPos.Y + i * Pos.Y)-(ScaleWidth, CurPos.Y + i * Pos.Y), &HAAAAAA
  74.         Next i
  75.         For i = 1 To ScaleWidth / Pos.X
  76.             Line (CurPos.X + i * Pos.X, 0)-(CurPos.X + i * Pos.X, ScaleHeight), &HAAAAAA
  77.         Next i
  78.     End If
  79.     ' Draw Axis to drawing field.
  80.     If ShowAxis Then
  81.         DrawWidth = 2
  82.         Line (Gadget.Left, 0)-(Gadget.Left, ScaleHeight), vbBlue
  83.         Line (0, Gadget.Top)-(ScaleWidth, Gadget.Top), vbRed
  84.     End If
  85. End Sub
  86. Private Sub Form_Load()
  87.     Set Gadget = New csShape
  88.     ' Initialization settings
  89.     With Gadget
  90.         Set .Field = Me
  91.         .Left = ScaleWidth / 2
  92.         .Top = ScaleHeight / 2
  93.     End With
  94.     ShowGrid = True
  95.     ShowAxis = True
  96.     Gradient = True
  97.     BkColor = BackColor
  98.     BaseColor = &HFF ' Red
  99.     GradColor = &HFF00& ' Green
  100.     LineWidth = 1
  101. End Sub
  102. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  103.     If Button = 2 Then
  104.         ' Center axis on mousepoint.
  105.         Gadget.Left = CDbl(X)
  106.         Gadget.Top = CDbl(Y)
  107.     End If
  108.     DrawShape
  109. End Sub
  110. Private Sub Form_Resize()
  111.     ' Redraw shape
  112.     DrawShape
  113. End Sub
  114. Private Sub Form_Unload(Cancel As Integer)
  115.     ' Disable toolbox.
  116.     frmToolbox.Activate False
  117. End Sub
  118. ' Notice that the Object menu at the top of this code window
  119. ' contains an object called Gadget, then there are no controls on
  120. ' the form. That is because the "WithEvents" part of the line:
  121. ' Public WithEvents Gadget As csShape
  122. ' Includes the Gadget object into the object window, so events
  123. ' contained in the control may be accessed.
  124. Private Sub Gadget_DrawLine(LineNum As Long, Color As Long)
  125.     If Not Gradient Then Exit Sub
  126.     ' Find the color (Line*100/Numlines)% the way on a gradient
  127.     ' between GradColor and BaseColor
  128.     Color = ColorBetween(GradColor, BaseColor, LineNum / NumLines)
  129. End Sub
  130.